' ****** START INCLUDE Rgba Core:::RgbaCircle(x%, y%, r%, c&, a~%%, f%) ******
DIM r0%, g0%, b0%, a0%, r1%, g1%, b1%, a1%
DIM RgbaAreaBorder& = &h1

SUB SetRgb0(x#,y#)
    DIM c& = (POINT(x#,y#))
    r0% = _RED(c&)
    g0% = _GREEN(c&)
    b0% = _BLUE(c&)
END SUB

SUB SetRgb1(c&,a~%%)
    r1% = _RED(c&)
    g1% = _GREEN(c&)
    b1% = _BLUE(c&)
    a0% = 255 - a~%%
    a1% = a~%%
END SUB

SUB RgbaCorePset(x#,y#)
    PSET(x#,y#), _RGB( [{ (r0%*a0%)+(r1%*a1%) }/255], [{ (g0%*a0%)+(g1%*a1%) }/255], [{ (b0%*a0%)+(b1%*a1%) }/255] )
END SUB



Sub RgbaCircle(xc#, yc#, r#, c&, a~%%, f%)

    DIM xc%, yc%, r%, x1%, y1%, x2%, y2%, x%, y%, okay%
    LET xc% = fix(xc#) : yc% = FIX(yc#) : r% = FIX(r#)

    IF (xc% + r% < 0) OR (xc% - r% > xMAX) OR (yc% + r% < 0) OR (yc% - r% > yMAX)  THEN
        DoNothing
    ELSE
        FOR xz# = xc% - r% TO xc% + r%
          FOR yz# = yc% - r% TO yc% + r%
          MAPSET("Rgba"+xz#+","+yz#,POINT(xz#,yz#))
        NEXT yz# : NEXT xz#
        IF f% = 2 THEN
           CIRCLE (xc%, yc%), r%, RgbaAreaBorder&, , , ,T
        ELSEIF f% = 1 THEN
           CIRCLE (xc%, yc%), r%, RgbaAreaBorder&, , , ,F
        ELSE
           CIRCLE (xc%, yc%), r%, RgbaAreaBorder&
        END IF
        SetRgb1(c&, a~%%)
        FOR x# = xc% - r% TO xc% + r%
          FOR y# = yc% - r% TO yc% + r%
            IF POINT(x#,y#) = RgbaAreaBorder& THEN pset(x#,y#),MAPGET("Rgba"+x#+","+y#): SetRgb0(x#,y#) : RgbaCorePset(x#,y#)
        NEXT y# : NEXT x#
    END IF   
END SUB
'  ****** END INCLUDE Rgba Core:::RgbaCircle(x%, y%, r%, c&, a~%%, f%) ******_title = "Oriental Paintbrush Sim"
' This program exported from BASIC Anywhere Machine (Version [5.2.3].[2024.09.09.00.00]) on 2024.10.08 at 00:56 (Coordinated Universal Time)
' This is a port and mod by Charlie Veniot of the QBJS "Calligraphy Pro 128 Studio:  Oriental paintbrush mode" by Vince
' shared on the "GotBASIC" discord



OPTION EXPLICIT
DIM AS INTEGER sw, sh, mx, my, mb, mw
DIM x%, y%, c~%%, n%, i%, r%, a#, ox#, oy#, dt#, t#, bx#, by#, bin#, j%, p#, rr%
DECLARE SUB GET_MOUSE()


sw = 400
sh = 300
SCREEN _NEWIMAGE( sw, sh, 27 )
'COLOR , _RGB( 245, 245, 220 ) 'LIGHT BEIGE
'COLOR , _RGB( 152, 133, 88 ) 'DARK BEIGE
COLOR , _RGB( 202, 183, 138 ) 'MIDDLING BEIGE
CLS
PCOPY 0, 1


n% = 25
DIM x( n% ), y( n% )
 
FOR i% = 0 TO n% - 1
    x( i% ) = sw / 2
    y( i% ) = i% * sh / n%
NEXT
 
r% = 5
mw = r%

DO
    PCOPY 1, 0
    CALL get_mouse()
    r% = mw
 
    x( 0 ) = mx
    y( 0 ) = my
    FOR i% = 1 TO n% - 1
        IF ( ( x( i% - 1 ) - x( i% ) ) ^ 2 + ( y( i% - 1 ) - y( i% ) ) ^ 2 ) > r% * r% THEN
            a# = _ATAN2( y( i% - 1 ) - y( i% ), x( i% - 1 ) - x( i% ) ) - _PI
            x( i% ) = x( i% - 1 ) + r% * COS( a# )
            y( i% ) = y( i% - 1 ) + r% * SIN( a# )
        END IF
    NEXT
 
    PRESET( x( 0 ), y( 0 ) )
    ox# = POINT( 0 ) ' x( 0 )
    oy# = POINT( 1 ) ' y( 0 )
    dt# = 0.01
    FOR t# = 0 TO 1 STEP dt#
        bx# = 0
        by# = 0    
        FOR i% = 0 TO n% - 1
            bin# = 1
            FOR j%= 1 TO i%
                bin# = bin# * ( n% - j% ) / j%
            NEXT j%
            p# = bin# * ( ( 1 - t# ) ^ ( n% - 1 - i% ) ) * ( t# ^ i% )
            bx# = bx# + p# * x( i% )
            by# = by# + p# * y( i% )
        NEXT i%
        IF ABS( bx# - ox# ) > 1 AND ABS( by# - oy# ) > 1 THEN
            IF BETWEEN( _MOUSEX, 0, XMAX ) AND BETWEEN( _MOUSEY, 0, YMAX ) THEN LINE TO ( bx#, by# ), _RGB( 0, 0, 0 )
            ox# = bx#
            oy# = by#
        END IF
    NEXT t#
    IF BETWEEN( _MOUSEX, 0, XMAX ) AND BETWEEN( _MOUSEY, 0, YMAX ) THEN LINE TO ( bx#, by# ), _RGB( 0, 0, 0 )
    
    IF _MOUSEBUTTON THEN
        PCOPY 1, 0
        dt# = 0.01
        FOR t# = 0 TO 1 STEP dt#
            bx# = 0
            by# = 0    
            FOR i% = 0 TO n% - 1
                bin# = 1
                FOR j% = 1 TO i%
                    bin# = bin# * ( n% - j% ) / j%
                NEXT j%
        
                p# = bin# * ( ( 1 - t# ) ^ ( n% - 1 - i% ) ) * ( t# ^ i% )
                bx# = bx# + p# * x( i% )
                by# = by# + p# * y( i% )
                          
            NEXT i%
 
            rr% = 1' 2 * EXP( -10 * ( t# ) * ( t# ) )
            CALL RgbaCircle( bx#, by#, rr%, _RGB( 0, 0, 0 ), 10, FALSE )
        
        NEXT t#
        PCOPY 0, 1
    END IF
 
 
    SLEEP 0.001
LOOP

END 
 
SUB get_mouse()
        mx = MAX( MIN( _mousex, XMAX ), 0 )
        my = MAX( MIN( _mousey, YMAX ), 0 )
END SUB